;This function determins the norm of a vector
(defun norm (vec)
  (sqrt (+ (* (nth 0 vec) (nth 0 vec))
	   (* (nth 1 vec) (nth 1 vec))
	   (* (nth 2 vec) (nth 2 vec))
	   );sum
	);sqrt
  );defun

;This function determins a vector perpendicular to other two
;by the use of the cross product
(defun perpendicular (vec1 vec2 / res)
  (setq res (append res (list (- (* (nth 1 vec1) (nth 2 vec2)) (* (nth 2 vec1) (nth 1 vec2))))))
  (setq res (append res (list (- (* (nth 2 vec1) (nth 0 vec2)) (* (nth 0 vec1) (nth 2 vec2))))))
  (setq res (append res (list (- (* (nth 0 vec1) (nth 1 vec2)) (* (nth 1 vec1) (nth 0 vec2))))))
  );defun

;---------------------------------------------------------------------
;---------------------------------------------------------------------
;3D fractal generating function
(defun spacefractal (n / point edge)
  (defun tri (level pt1 pt2 pt3 / mtd1 mtd2 mtd3 apex aux vec1 vec2 c ap1 ap2 ap3)
    (setq mtd1 (append (list (/ (+ (nth 0 pt1) (nth 0 pt2)) 2 ))
		       (list (/ (+ (nth 1 pt1) (nth 1 pt2)) 2 ))
		       (list (/ (+ (nth 2 pt1) (nth 2 pt2)) 2 ))
	       ); append
	  );setq
    (setq mtd2 (append (list (/ (+ (nth 0 pt2) (nth 0 pt3)) 2 ))
		       (list (/ (+ (nth 1 pt2) (nth 1 pt3)) 2 ))
		       (list (/ (+ (nth 2 pt2) (nth 2 pt3)) 2 ))
	       ); append
	  );setq
    (setq mtd3 (append (list (/ (+ (nth 0 pt1) (nth 0 pt3)) 2 ))
		       (list (/ (+ (nth 1 pt1) (nth 1 pt3)) 2 ))
		       (list (/ (+ (nth 2 pt1) (nth 2 pt3)) 2 ))
	       ); append
	  );setq
    (setq apex (append (list (+ (* (/ 1 3.00000) (nth 0 pt1)) (* (/ 1 3.00000) (+ (nth 0 pt3) (nth 0 pt2)))))
		       (list (+ (* (/ 1 3.00000) (nth 1 pt1)) (* (/ 1 3.00000) (+ (nth 1 pt3) (nth 1 pt2)))))
		       (list (+ (* (/ 1 3.00000) (nth 2 pt1)) (* (/ 1 3.00000) (+ (nth 2 pt3) (nth 2 pt2)))))
		       );append
	  );setq
    (setq ap1 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt1))
    (setq ap2 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt2))
    (setq ap3 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt3))

    (setq vec1 (mapcar '- pt2 pt1))
    (setq vec2 (mapcar '- pt3 pt1))
    (setq aux (perpendicular vec1 vec2))
    (setq c (norm aux))
    (setq c (* (/ (sqrt 6) 3) (/ 1 c) (/ (norm vec1) 2)))
    (setq aux (mapcar '* (list c c c) aux)); easy way of multiplying
    (setq ap1 (mapcar '+ ap1 aux))
    (setq ap2 (mapcar '+ ap2 aux))
    (setq ap3 (mapcar '+ ap3 aux))
    (if (> level 1)
      (progn
	(tri (- level 1) ap1 pt1 mtd1)
	(tri (- level 1) ap1 mtd3 pt1)
	(tri (- level 1) ap2 mtd1 pt2)
	(tri (- level 1) ap2 pt2 mtd2)
	(tri (- level 1) ap3 mtd2 pt3)
	(tri (- level 1) ap3 pt3 mtd3)
	);progn
      (progn; Construction of the faces at the base level
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 pt1)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 mtd3)
		   (cons 12 pt1)
		   (cons 13 pt1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 mtd1)
		   (cons 12 pt2)
		   (cons 13 pt2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 pt2)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 mtd2)
		   (cons 12 pt3)
		   (cons 13 pt3)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 pt3)
		   (cons 12 mtd3)
		   (cons 13 mtd3)
		   );list
		 );entmake
	);progn
      );if
    );defun

  (while (not (setq point (getpoint "\nInsert point: "))) (princ "\nPoint required."))
  (while (not (setq edge (getdist "\nInsert edge length "))) (princ "\nEdge length required."))
  (tri n
       point
       (polar point 0 edge)
       (polar point (/ Pi 3) edge)
       ); tri
  );defun

;---------------------------------------------------------------------
;---------------------------------------------------------------------
;This function builds a 3D fractal figure
(defun Sfractal (n / point edge)
  (defun tri (level pt1 pt2 pt3 / mtd1 mtd2 mtd3 apex aux vec1 vec2 c ap1 ap2 ap3)
    (setq mtd1 (append (list (/ (+ (nth 0 pt1) (nth 0 pt2)) 2 ))
		       (list (/ (+ (nth 1 pt1) (nth 1 pt2)) 2 ))
		       (list (/ (+ (nth 2 pt1) (nth 2 pt2)) 2 ))
	       ); append
	  );setq
    (setq mtd2 (append (list (/ (+ (nth 0 pt2) (nth 0 pt3)) 2 ))
		       (list (/ (+ (nth 1 pt2) (nth 1 pt3)) 2 ))
		       (list (/ (+ (nth 2 pt2) (nth 2 pt3)) 2 ))
	       ); append
	  );setq
    (setq mtd3 (append (list (/ (+ (nth 0 pt1) (nth 0 pt3)) 2 ))
		       (list (/ (+ (nth 1 pt1) (nth 1 pt3)) 2 ))
		       (list (/ (+ (nth 2 pt1) (nth 2 pt3)) 2 ))
	       ); append
	  );setq
    (setq apex (append (list (+ (* (/ 1 3.00000) (nth 0 pt1)) (* (/ 1 3.00000) (+ (nth 0 pt3) (nth 0 pt2)))))
		       (list (+ (* (/ 1 3.00000) (nth 1 pt1)) (* (/ 1 3.00000) (+ (nth 1 pt3) (nth 1 pt2)))))
		       (list (+ (* (/ 1 3.00000) (nth 2 pt1)) (* (/ 1 3.00000) (+ (nth 2 pt3) (nth 2 pt2)))))
		       );append
	  );setq
    (setq ap1 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt1))
    (setq ap2 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt2))
    (setq ap3 (mapcar '(lambda (x y) (+ (* (/ 2 3.00000) x) (* (/ 1 3.00000) y))) apex pt3))

    (setq vec1 (mapcar '- pt2 pt1))
    (setq vec2 (mapcar '- pt3 pt1))
    (setq aux (perpendicular vec1 vec2))
    (setq c (norm aux))
    (setq c (* (/ (sqrt 6) 3) (/ 1 c) (/ (norm vec1) 4)))
    (setq aux (mapcar '* (list c c c) aux)); easy way of multiplying
    (setq ap1 (mapcar '+ ap1 aux))
    (setq ap2 (mapcar '+ ap2 aux))
    (setq ap3 (mapcar '+ ap3 aux))
    (if (> level 1)
      (progn
	(tri (- level 1) ap1 pt1 mtd1)
	(tri (- level 1) ap1 mtd3 pt1)
	(tri (- level 1) ap2 mtd1 pt2)
	(tri (- level 1) ap2 pt2 mtd2)
	(tri (- level 1) ap3 mtd2 pt3)
	(tri (- level 1) ap3 pt3 mtd3)
	
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 mtd3)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 mtd2)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 mtd3)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 mtd1)
		   (cons 11 mtd3)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   (cons 62 5);blue color
		   );list
		 );entmake
	);progn
      (progn ;
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 pt1)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 mtd3)
		   (cons 12 pt1)
		   (cons 13 pt1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 mtd1)
		   (cons 12 pt2)
		   (cons 13 pt2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 pt2)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 mtd2)
		   (cons 12 pt3)
		   (cons 13 pt3)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 pt3)
		   (cons 12 mtd3)
		   (cons 13 mtd3)
		   );list
		 );entmake
	;close the remaining faces
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap1)
		   (cons 11 mtd3)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap2)
		   (cons 11 mtd2)
		   (cons 12 mtd1)
		   (cons 13 mtd1)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 ap3)
		   (cons 11 mtd3)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   );list
		 );entmake
	(entmake (list
		   (cons 0 "3dface")
		   (cons 10 mtd1)
		   (cons 11 mtd3)
		   (cons 12 mtd2)
		   (cons 13 mtd2)
		   (cons 62 5)
		   );list
		 );entmake
	);progn
      );if
    );defun

  (while (not (setq point (getpoint "\nInsert point: "))) (princ "\nPoint required."))
  (while (not (setq edge (getdist "\nInsert edge length "))) (princ "\nEdge length required."))
  (tri n
       point
       (polar point 0 edge)
       (polar point (/ Pi 3) edge)
       ); tri
  );defun